home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 1992 August
/
info-mac-1992.iso
/
Source
/
3D GrafSys
/
GrafSys.rel
/
BuildObject ƒ
/
BuildObject.p
next >
Wrap
Text File
|
1992-04-17
|
9KB
|
322 lines
program BuildObject;
{ This program should be used to create your own 3D objects. Modify the }
{ MakeObject procedure to build your own objects. If the object is what }
{ you wanted, remove the comment marks around the saveobject call and }
{ your object will be saved to the BuildObject.rsc file }
{}
{ Copyright (c) 1992 by Christian Franz }
uses
GrafSys, Screen3D;
(* Matrix, Transformations, Data3D, ResourceAccess, Grafsys, Screen3D; *)
const
theWindowID = 400;
degree = 0.01745329; (* π/180 *)
var
theWindow: WindowPtr;
theInt: INTEGER;
thePort: Graf3DPtr;
theMaster: Graf3DPtr;
theObject: GrafObjPtr;
theEvent: EventRecord;
dx, dy, dz: integer;
r, PR, VR: Rect;
SO: ScreenObjPtr;
dummy: boolean;
procedure MakeObject (var Obj: GrafObjPtr);
var
count: INTEGER;
OK: Boolean;
p: Polygon;
dummy: integer;
begin
Obj := NewObject;
OK := AddPoint(Obj, 300, 500, 0, count); (*house basement *)
OK := AddPoint(Obj, 300, 900, 0, count);
OK := AddPoint(Obj, 600, 900, 0, count);
OK := AddPoint(Obj, 600, 500, 0, count);
OK := AddPoint(Obj, 300, 500, 200, count); (*house top basement *)
OK := AddPoint(Obj, 300, 900, 200, count);
OK := AddPoint(Obj, 600, 900, 200, count);
OK := AddPoint(Obj, 600, 500, 200, count);
OK := AddPoint(Obj, 450, 600, 300, count); (* roof *)
OK := AddPoint(Obj, 450, 800, 300, count);
OK := AddPoint(Obj, 1000, -400, 0, count); (* house garden *)
OK := AddPoint(Obj, 1000, 1200, 0, count);
OK := AddPoint(Obj, -300, 1200, 0, count);
OK := AddPoint(Obj, -300, -400, 0, count);
OK := AddPoint(Obj, 0, 0, 0, count); (* tree at origin *)
OK := AddPoint(Obj, 0, 0, 300, count);
OK := AddPoint(Obj, 100, -100, 500, count); (* 17 *)
OK := AddPoint(Obj, 0, 150, 400, count); (* 18 *)
OK := AddPoint(Obj, -160, -100, 450, count); (* 19 *)
OK := AddLine(Obj, 1, 2); (* the basement *)
OK := AddLine(Obj, 2, 3);
OK := AddLine(Obj, 3, 4);
OK := AddLine(Obj, 4, 1);
OK := AddLine(Obj, 1, 5);
OK := AddLine(Obj, 5, 6);
OK := AddLine(Obj, 6, 7);
OK := AddLine(Obj, 7, 8);
OK := AddLine(Obj, 8, 5);
OK := AddLine(Obj, 5, 9); (* roof begin *)
OK := AddLine(Obj, 9, 10);
OK := AddLine(Obj, 10, 6);
OK := AddLine(Obj, 6, 2); (* house side 2 *)
OK := AddLine(Obj, 3, 7);
OK := AddLine(Obj, 7, 10); (* and the rest *)
OK := AddLine(Obj, 4, 8);
OK := AddLine(Obj, 8, 9);
OK := AddLine(Obj, 11, 12); (* garden *)
OK := AddLine(Obj, 12, 13);
OK := AddLine(Obj, 13, 14);
OK := AddLine(Obj, 14, 11);
OK := AddLine(Obj, 15, 16); (* tree *)
OK := AddLine(Obj, 15, 16);
OK := AddLine(Obj, 16, 17);
OK := AddLine(Obj, 17, 18);
OK := AddLine(Obj, 18, 16);
OK := AddLine(Obj, 16, 19);
OK := AddLine(Obj, 19, 17);
OK := AddLine(Obj, 19, 18);
end;
procedure getmouserot (var dx, dy, dz: integer);
var
thePoint: point;
begin
GetMouse(thePoint);
dx := 0;
dy := 0;
dz := 0;
if (thePoint.h < thePort^.center.h) and (thePoint.v < thePort^.center.v) then (* mouse in quadrant 1 -> xrot*)
begin
dx := 5;
end;
if (thePoint.h > thePort^.center.h) and (thePoint.v < thePort^.center.v) then (* mouse in quadrant 2 -> yrot*)
begin
dy := 5;
end;
if (thePoint.h > thePort^.center.h) and (thePoint.v > thePort^.center.v) then (* mouse in quadrant 3 -> zrot*)
begin
dz := 5;
end;
if (thePoint.h < thePort^.center.h) and (thePoint.v > thePort^.center.v) then (* mouse in quadrant 4 -> idle*)
begin
end;
if button then
begin
dx := -dx;
dy := -dy;
dz := -dz;
end;
end;
const
closer = 58; (* option Key *)
further = 55; (* command key *)
haltkey = 76; (* keypad enter *)
leftArrow = $7B;
rightArrow = $7C;
upArrow = $7E;
downArrow = $7D;
num1 = $53;
num2 = $54;
upKey = $22; (* I *)
downKey = $2E; (* M *)
leftKey = $26; (* J *)
rightKey = $28;(* K *)
forwardKey = $0C; (* Q *)
backwardKey = $00; (* A *)
var
theKeys: KeyMap;
theta, phi: integer;
pitch: integer;
update: boolean;
x, y, z: Real;
(* Procedure to read keyboard commands. the following commands are defined: *)
(* *)
(* Option : translate object up down on z-achsis *)
(* Command : translate object up on z-achsis *)
(* *)
(* leftArrow : decrease theta *)
(* right arrow : increase theta *)
(* upArrow : increase phi *)
(* downarrow : decrease phi *)
(* numblock-1 : decrease pitch *)
(* numblock-2 : increase pitch *)
(* *)
(* Enter : stop program *)
procedure KeyCommand;
begin
GetKeys(theKeys);
if theKeys[further] then
ObjTranslate(theObject, 0, 0, 10);
if theKeys[closer] then
ObjTranslate(theObject, 0, 0, -10);
if theKeys[leftArrow] then
begin
theta := (theta + 5) mod 355;
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[rightArrow] then
begin
theta := (theta - 5) mod 355;
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[upArrow] then
begin
phi := (phi + 5) mod 355;
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[downArrow] then
begin
phi := (phi - 5) mod 355;
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[num1] then
begin
pitch := (pitch + 5) mod 355;
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[num2] then
begin
pitch := (pitch - 5) mod 355;
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[upKey] then
begin
z := (z + 5);
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[downKey] then
begin
z := (z - 5);
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[leftKey] then
begin
y := (y - 5);
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[rightKey] then
begin
y := (y + 5);
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[forwardKey] then
begin
x := (x + 5);
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
if theKeys[backwardKey] then
begin
x := (x - 5);
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
update := true;
end;
end;
(* main program *)
begin
InitCursor;
theWindow := GetNewWindow(theWindowID, nil, Pointer(-1));
SetPort(theWindow); (* draw in this window *)
MoveTo(10, 10);
DrawString('3D GrafSys. TestObject. (C) 1992 by CF.');
InitGrafSys;
NewGrafport(theWindow^.portRect, thePort);
MoveTo(10, 25 * 15);
DrawString('Descr. : Press Keypad-Enter to stop');
MoveTo(10, 26 * 15);
DrawString(' Option to zoom closer');
MoveTo(10, 27 * 15);
DrawString(' Command to move further away');
MoveTo(10, 28 * 15);
DrawString(' Move mouse into fighter to rotate it');
PR := theWindow^.PortRect;
SetRect(VR, thePort^.center.h - 0, thePort^.center.v - 100, thePort^.center.h + 220, thePort^.center.v + 100);
r := VR;
for dx := 1 to 3 do
begin
InsetRect(r, -2, -2);
FrameRect(r);
end;
SetView(PR, VR);
SetCenter(thePort^.center.h + 120, thePort^.center.v);
MakeObject(theObject);
(* SaveObject(theObject, 'House & Garden', 1102); *)
phi := 0;
theta := 0;
pitch := 0;
x := 0;
y := 0;
z := 0;
SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
ObjTranslate(theObject, 0, 0, 0);
ObjRotate(theObject, 0 * degree, 0 * degree, 0);
SetAutoErase(theObject, true);
SO := NewScreenObject;
AttachScreenObject(SO, theObject); (* Link for all changes *)
CCalcScreenObject(theObject, TRUE);
DrawScreenObject(theObject);
repeat
GetMouseRot(dx, dy, dz);
if (dx + dy + dz <> 0) or (theKeys[closer]) or (theKeys[further]) or update then
DrawScreenObject(theObject); (* draw Object *)
update := false;
ObjRotate(theObject, dx * degree, dy * degree, dz * degree);
KeyCommand; (* look at keyboard and do action required *)
CCalcScreenObject(theObject, TRUE);
until theKeys[haltkey];
end.